Mapa de Calor

Wuandy Ayala

Mapas de calor

Intentos de suicidio en colombia desde 2016 hasta 2023

Cada fila corresponde a una persona que intentó suicidarse e incluye información como el municipio y departamento de ocurrencia.

✨ Clase con el experto David Santis ✨

Librerías

Code

library(sf)
library(dplyr)
library(ggplot2)
library(tidyverse)
library(readr)
library(plotly)
library(RColorBrewer)
library(stringi)
library(scales)
library(grid)
library(ggpubr)

Mapa base de Colombia y Introducción

Code

colombia <- read_sf("Colombia.geojson")
colombia |> 
  ggplot() + 
  geom_sf(fill = "lightblue", color = "black" ) + 
  theme_minimal() + 
  labs(title = "Mapa base de Colombia")

Code

Departamento_ocurrencia = c(
     "ANTIOQUIA", "ATLANTICO", "BOGOTA", "BOLIVAR", "BOYACA", "CALDAS", "CAQUETA",  "CAUCA", "CESAR", "CORDOBA", "CUNDINAMARCA","CHOCO", "HUILA", "GUAJIRA", 
"MAGDALENA",  "META", "NARIÑO","NORTE DE SANTANDER","QUINDIO", "RISARALDA","SANTANDER" , "SUCRE","TOLIMA", "VALLE", "ARAUCA ", "CASANARE",  "PUTUMAYO", "AMAZONAS", "GUAINIA", "GUAVIARE",  "VAUPES",
    "VICHADA", "SAN ANDRÉS")

colombia$NOMBRE_DPT <- Departamento_ocurrencia

Entre 2016 y 2023, Colombia registró un aumento sostenido en los intentos de suicidio, con cifras alarmantes en municipios de departamentos como Vaupés, Risaralda, Caldas, Santander, Putumayo y Amazonas. Solo entre enero y mayo de 2023 se notificaron 40.850 intentos y 3.241 suicidios consumados, siendo Bucaramanga, Floridablanca, Mitú y Taraira algunos de los municipios más afectados. La mayor incidencia se presentó en jóvenes y adolescentes, especialmente en regiones rurales e indígenas, evidenciando la necesidad de intervenciones focalizadas.

Intentos de suicidio en Colombia desde 2016 hasta 2023

Code

# Bases de datos

suicidio_data2016 <- read_csv("suicidio_data2016.csv")
suicidio_data2017 <- read_csv("suicidio_data2017.csv")
suicidio_data2018 <- read_csv("suicidio_data2018.csv")
suicidio_data2019 <- read_csv("suicidio_data2019.csv")
suicidio_data2020 <- read_csv("suicidio_data2020.csv")
suicidio_data2021 <- read_csv("suicidio_data2021.csv")
suicidio_data2022 <- read_csv("suicidio_data2022.csv")
suicidio_data2023 <- read_csv("suicidio_data2023.csv")

Datos_completos <- bind_rows(suicidio_data2016, suicidio_data2017, suicidio_data2018,suicidio_data2019,suicidio_data2020,suicidio_data2021,suicidio_data2022, suicidio_data2023)

Datos_completos <- Datos_completos |>
  filter(Departamento_ocurrencia != "PROCEDENCIA DESCONOCIDA", Municipio_ocurrencia != "* ANTIOQUIA. MUNICIPIO DESCONOCIDO")

Datos_completos <- Datos_completos |> group_by(ANO, COD_DPTO_O, Departamento_ocurrencia, COD_MUN_O, Municipio_ocurrencia ) |> summarise(Total_casos = n(), .groups = "drop") |> filter(Total_casos > 0)

datos_departamentos <- Datos_completos %>%
  group_by(ANO, COD_DPTO_O, Departamento_ocurrencia) %>%
  summarise(Total_casos_dep = sum(Total_casos, na.rm = TRUE), .groups = "drop")

datos_dpto_resumidos <- datos_departamentos %>%
  group_by(ANO,COD_DPTO_O,Departamento_ocurrencia) %>%
  summarise(Total_casos_dep_año = sum(Total_casos_dep, na.rm = TRUE), .groups = "drop")


Departamento_ocurrencia <- c(
  "ANTIOQUIA", "ATLANTICO", "BOGOTA", "BOLIVAR", "BOYACA", "CALDAS", "CAQUETA",
  "CAUCA", "CESAR", "CORDOBA", "CUNDINAMARCA", "CHOCO", "HUILA", "GUAJIRA",
  "MAGDALENA", "META", "NARIÑO", "NORTE SANTANDER", "QUINDIO", "RISARALDA",
  "SANTANDER", "SUCRE", "TOLIMA", "VALLE", "ARAUCA", "CASANARE", "PUTUMAYO",
  "AMAZONAS", "GUAINIA", "GUAVIARE", "VAUPES", "VICHADA", "SAN ANDRES"
)

Poblacion_2023 <- c(
  6848360, 2803565, 7907281, 2247283, 1298800, 1040284, 425053,
  1558045, 1373581, 1898911, 3445327, 595138, 1178453, 1038397,
  1496163, 1130085, 1699570, 1696740, 563076, 972304,
  2357127, 994060, 1374384, 4638029, 313097, 467775, 383042,
  85056, 56551, 97616, 46777, 123304, 62269
)

df_poblacion <- tibble(
  Departamento_ocurrencia,
  Poblacion_2023
)

Datos_Dpto_completos <- datos_dpto_resumidos |>
  left_join(df_poblacion, by = "Departamento_ocurrencia")


top_15_departamentos <- Datos_Dpto_completos %>%
  arrange(desc(Total_casos_dep_año)) %>%
  slice_head(n = 15)

top_15_departamentos

# A tibble: 15 × 5
     ANO COD_DPTO_O Departamento_ocurrencia Total_casos_dep_año Poblacion_2023
   <dbl>      <dbl> <chr>                                 <int>          <dbl>
 1  2023          5 ANTIOQUIA                              6286        6848360
 2  2023         11 BOGOTA                                 6046        7907281
 3  2022         11 BOGOTA                                 5737        7907281
 4  2022          5 ANTIOQUIA                              5615        6848360
 5  2019          5 ANTIOQUIA                              5156        6848360
 6  2018          5 ANTIOQUIA                              4982        6848360
 7  2017          5 ANTIOQUIA                              4735        6848360
 8  2021         11 BOGOTA                                 4565        7907281
 9  2021          5 ANTIOQUIA                              4482        6848360
10  2020          5 ANTIOQUIA                              4283        6848360
11  2023         76 VALLE                                  3749        4638029
12  2022         76 VALLE                                  3442        4638029
13  2019         76 VALLE                                  3099        4638029
14  2016          5 ANTIOQUIA                              3033        6848360
15  2020         11 BOGOTA                                 3019        7907281

Entre 2017 y 2023, los intentos de suicidio en Colombia muestran una tendencia creciente, especialmente en los departamentos de Antioquia y Bogotá, que concentran las cifras más altas del país. En 2023, Antioquia reportó 6.286 casos y Bogotá 6.046, reflejando un aumento sostenido en comparación con años anteriores. Esta evolución sugiere un agravamiento de los problemas de salud mental o una mejora en los sistemas de registro y notificación.

La concentración de casos en estos territorios podría estar relacionada con factores como la alta densidad poblacional, el estrés urbano, la desigualdad social o el acceso limitado a servicios de salud mental.

Total de Casos por Departamentos y Año

Code

departamentos <- unique(Datos_Dpto_completos$Departamento_ocurrencia)
n <- length(departamentos)

pal <- colorRampPalette(brewer.pal(8, "Set2"))(n)

fig <- Datos_Dpto_completos %>%
  plot_ly(
    x = ~ANO,
    y = ~Total_casos_dep_año,
    color = ~Departamento_ocurrencia,
    colors = pal,
    type = 'scatter',
    mode = 'lines+markers',
    hoverinfo = 'text',
    text = ~paste("Departamento:", Departamento_ocurrencia,
                  "<br>Año:", ANO,
                  "<br>Casos:", Total_casos_dep_año)
  ) %>%
  layout(
    title = "Evolución anual de casos por departamento",
    xaxis = list(title = "Año"),
    yaxis = list(title = "Total casos"),
    legend = list(title = list(text = "<b>Departamento</b>"))
  )

fig

Code

data_total_departamento_acumulado <- Datos_Dpto_completos |>
  group_by(COD_DPTO_O, Departamento_ocurrencia) |>
  summarise(Total_casos_acumulado = sum(Total_casos_dep_año), .groups = "drop") |>
  arrange(desc(Total_casos_acumulado))

fig <- plot_ly(
  data = data_total_departamento_acumulado,
  x = ~Total_casos_acumulado,
  y = ~reorder(Departamento_ocurrencia, Total_casos_acumulado),
  type = 'bar',
  orientation = 'h',
  marker = list(color = 'navy')
) %>%
  layout(
    title = "Casos acumulados por departamento",
    xaxis = list(title = "Total casos acumulados"),
    yaxis = list(title = "", automargin = TRUE)
  )

fig

Tasa y Total de Intentos de suicidio en Colombia

Code

Datos_Dpto_completos <- Datos_Dpto_completos %>%
  mutate(Tasa = (Total_casos_dep_año / Poblacion_2023) * 100000)

colombia <- colombia %>%
  mutate(DPTO = as.character(DPTO))

Datos_Dpto_completos <- Datos_Dpto_completos %>%
  mutate(COD_DPTO_O = as.character(COD_DPTO_O))

Datos_Dpto_completos <- Datos_Dpto_completos %>%
  mutate(
    Departamento_ocurrencia = trimws(Departamento_ocurrencia),
    Departamento_ocurrencia = case_when(
      Departamento_ocurrencia == "NORTE SANTANDER" ~ "NORTE DE SANTANDER",
      Departamento_ocurrencia == "ARAUCA" ~ "ARAUCA ",
      Departamento_ocurrencia == "SAN ANDRES" ~ "SAN ANDRÉS",
      TRUE ~ Departamento_ocurrencia
    )
  )


BASE_DPTO <- colombia %>%
  left_join(Datos_Dpto_completos, by = c("NOMBRE_DPT" = "Departamento_ocurrencia" ))

summary(BASE_DPTO$Total_casos_dep_año)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
    8.0   203.0   620.5   900.0  1101.0  6286.0

Code

colores_personalizados <- colorRampPalette(c("darkgreen", "yellow", "orange", "red", "blue", "navy"))(200)

ggplot(BASE_DPTO) + 
  geom_sf(aes(fill = Total_casos_dep_año), 
          color = "navy", lwd = 0.3) + 
  labs(
    title = "Total de Casos de Intentos de Suicidio \n por Departamento", 
    x = NULL, y = NULL, fill = "Total de Casos."
  ) +
  scale_fill_gradientn(
  colours = colores_personalizados,
  limits = range(BASE_DPTO$Total_casos_dep_año, na.rm = TRUE),
  breaks = pretty(BASE_DPTO$Total_casos_dep_año, n = 5),
  labels = as.character(pretty(BASE_DPTO$Total_casos_dep_año, n = 5))
) + 
  theme_minimal() + 
  theme(
    plot.title = element_text(size = 12, hjust = 0.2),
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank(),
    legend.position = "top",
    legend.key.width = unit(1.5, "cm")
  )

Code

colores_personalizados <- colorRampPalette(c("darkgreen", "yellow", "orange", "red", "blue", "navy"))(200)

ggplot(BASE_DPTO) + 
  geom_sf(aes(fill = Tasa), 
          color = "navy", lwd = 0.3) + 
  labs(
    title = "Tasa de Intentos de Suicidio \n por Departamento", 
    x = NULL, y = NULL, fill = "Tasa por\n100 mil hab."
  ) +
  scale_fill_gradientn(
  colours = colores_personalizados,
  limits = range(BASE_DPTO$Tasa, na.rm = TRUE),
  breaks = pretty(BASE_DPTO$Tasa, n = 5),
  labels = as.character(pretty(BASE_DPTO$Tasa, n = 5))
) + 
  theme_minimal() + 
  theme(
    plot.title = element_text(size = 12, hjust = 0.2),
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank(),
    legend.position = "top",
    legend.key.width = unit(1.5, "cm")
  )

VAUPÉS

Code

data=left_join(
  colombia%>% mutate(DPTO=as.numeric(DPTO)),
  Datos_Dpto_completos %>% mutate(COD_DPTO_O=as.numeric(COD_DPTO_O)),
  by=c("DPTO"="COD_DPTO_O"))


VAUPES_geom=data[data$NOMBRE_DPT =="VAUPES",]


bbox=st_bbox(VAUPES_geom)

b <- ggplot(data) +
  geom_sf(aes(fill = Tasa), color = "black", lwd = 0.3) +
  annotate("rect",
           xmin = bbox["xmin"], xmax = bbox["xmax"],
           ymin = bbox["ymin"], ymax = bbox["ymax"],
           color = "black", fill = NA, linewidth = 1) +
  labs(title = "", x = NULL, y = NULL, fill = "Tasa") +
  scale_fill_gradientn(
    colors = colores_personalizados,
    trans = "pseudo_log",
    breaks = c(0, 50, 100, 150, 200, 250),
    labels = c("0", "50", "100", "150", "200", "250")
  ) +
  theme_minimal() +
  theme(
    plot.title = element_text(size = 16, hjust = 0.5),
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank(),
    legend.position = "left",
    legend.key.width = unit(0.5, "cm"),
    legend.key.height = unit(1, "cm")
  )





colombia_esp <- read_sf("Colombia municipios.geojson")

VAUPES <- Datos_completos |> 
  filter(Departamento_ocurrencia == "VAUPES")


data_VAUPES <- VAUPES |> 
  mutate(Total_casos = as.numeric(Total_casos)) |>
  group_by(Municipio_ocurrencia,COD_MUN_O ) |>
  summarise(Total_Confirmados = sum(Total_casos))


colombia_esp <- colombia_esp %>%
  mutate(DPTO_CNMBR = if_else(DPTO_CNMBR == "VAUPÉS", "VAUPES", DPTO_CNMBR))

VAUPES_geom_esp <- colombia_esp |> filter(DPTO_CNMBR == "VAUPES")

data_VAUPES_esp <- left_join(
  VAUPES_geom_esp |> mutate(MPIO_CCDGO = as.numeric(MPIO_CCDGO)),
  data_VAUPES |> mutate("COD_MUN_O" = as.numeric(COD_MUN_O)), 
  by = c("MPIO_CCDGO" = "COD_MUN_O")
)

data_VAUPES_esp$Total_Confirmados[is.na(data_VAUPES_esp$Total_Confirmados)] <- 0

a=ggplot(data_VAUPES_esp)+
  geom_sf(aes(fill=Total_Confirmados), color="black", lwd=0.3)+
  labs( title = "",x=NULL, y=NULL, fill="Total")+
  scale_fill_gradientn(
    colors=colores_personalizados,
    trans="pseudo_log",
    breaks=c(0.00,   13.00  , 26.00  ,  44.25,81.00  ,  375.00 ),
    labels=c("0.00",   "13.00"  , "26.00"    , "44.25",  "81.00" ,"375.00" ))+
  theme_minimal()+
  theme(plot.title = element_text(size=16,hjust=0.5),
        axis.text = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
        legend.position = "left",
        legend.key.width = unit(0.5,"cm"),
        legend.key.height  = unit(1,"cm"))



mapas_combinados <- ggarrange(b,a,
                              ncol=2,nrow = 1,
                              common.legend = FALSE)
annotate_figure(mapas_combinados,top = text_grob("Tasa de Intentos de Suicidio \n en VAUPÉS", face = "bold",size = 14))

PLOTLY FINAL

Code

subplot(b, a, nrows = 1, shareY = FALSE, titleX = TRUE) |>
  layout(title = list(text = "Tasa de Intentos de Suicidio<br><sup>en VAUPÉS</sup>",
                      x = 0.5, xanchor = "center"),
         showlegend = FALSE)